home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Modules / relax.em < prev    next >
Lisp/Scheme  |  1993-07-03  |  5KB  |  158 lines
  1. ;; PDE solving using relaxation method
  2.  
  3. (defmodule relax (eulisp0 eulinda loops) ()
  4.  
  5.   ; initial values
  6.   (defconstant problem1
  7.     #( #(0.0 0.0 0.0 0.0 1.0)
  8.        #(0.0 0.0 0.0 0.0 1.0)
  9.        #(0.0 0.0 0.0 0.0 1.0)
  10.        #(0.0 0.0 0.0 0.0 1.0)
  11.        #(1.0 1.0 1.0 1.0 1.0) ))
  12.  
  13.   (defconstant problem2
  14.     #( #(2.0 1.0 1.0 2.0)
  15.        #(1.0 0.0 0.0 1.0)
  16.        #(1.0 0.0 0.0 1.0)
  17.        #(2.0 1.0 1.0 2.0) ))
  18.  
  19.   (defconstant problem3
  20.     #( #(2.0 1.0 1.0 1.0 2.0)
  21.        #(1.0 0.0 0.0 0.0 1.0)
  22.        #(1.0 0.0 0.0 0.0 1.0)
  23.        #(1.0 0.0 0.0 0.0 1.0)
  24.        #(2.0 1.0 1.0 1.0 2.0) ))
  25.   
  26.   (defconstant problem4 
  27.     #( #(2.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 2.0)
  28.        #(1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0)
  29.        #(1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0)
  30.        #(1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0)
  31.        #(1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0)
  32.        #(1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0)
  33.        #(1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0)
  34.        #(1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0)
  35.        #(1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0)
  36.        #(1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0)
  37.        #(1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0)
  38.        #(2.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 2.0)))
  39.  
  40.   ; (doit problem1 0.1)
  41.   ; (doit problem2 0.1)
  42.  
  43.   ;----------------------------------------------------------------------
  44.  
  45.   (deflocal epsilon 0)
  46.   (deflocal mesh-size 0)
  47.   (deflocal mesh-size1 0)
  48.   (deflocal total-count 0)
  49.   (deflocal relax-pool ())
  50.  
  51.   (defun make-array (n m)
  52.     (let ((arr (make-vector m))
  53.       (i 0))
  54.       (for () (< i m) (setq i (+ i 1))
  55.        ((setter vector-ref) arr i (make-vector n)))
  56.       arr))
  57.  
  58.   (defun aref (array x y) (vector-ref (vector-ref array x) y))
  59.  
  60.   ((setter setter) aref
  61.    (lambda (array x y val)
  62.      ((setter vector-ref) (vector-ref array x) y val)))
  63.  
  64.   (defun boundaryp (x y)
  65.     (or (= x 0)
  66.     (= y 0)
  67.     (= x mesh-size1)
  68.     (= y mesh-size1)))
  69.  
  70.   (defun init-mesh (vals)
  71.     (let ((i 0) (j 0))
  72.       (for () (< i mesh-size) (setq i (+ i 1))
  73.     (for (setq j 0) (< j mesh-size) (setq j (+ j 1))
  74.       (if (boundaryp i j)
  75.           (progn
  76.         (linda-out relax-pool 'value i j (aref vals i j) 'boundary)
  77.         (linda-out relax-pool 'result i j (aref vals i j) 'conv))
  78.           (linda-out relax-pool 'value i j (aref vals i j) 'inner))))))
  79.  
  80.   (defun relax ()
  81.     (let ((x ()) (y ()) (oldval ()))
  82.       (linda-read relax-pool 'value (? x) (? y) (? oldval) 'inner)
  83.       (format t "relax: ~a ~a ~a~%" x y oldval)
  84.       (let ((N ()) (E ()) (S ()) (W ()))
  85.     (linda-read relax-pool 'value x (+ y 1) (? N) ?)
  86.     (linda-read relax-pool 'value (+ x 1) y (? E) ?)
  87.     (linda-read relax-pool 'value x (- y 1) (? S) ?)
  88.     (linda-read relax-pool 'value (- x 1) y (? W) ?)
  89.     (let ((newval (/ (+ N E S W) 4.0)))
  90.       (linda-in relax-pool 'value x y ? 'inner)
  91.       (linda-out relax-pool 'value x y newval 'inner)
  92.       (if (< (abs (- oldval newval)) epsilon)
  93.           (linda-out relax-pool 'result x y newval 'conv)
  94.           (linda-out relax-pool 'result x y newval 'not-conv))
  95.       newval))))
  96.  
  97.   ; function to collect results
  98.   (defun collector (ans)
  99.     (let ((convgs (make-array mesh-size mesh-size)))
  100.       (collector-loop ans convgs 0)))
  101.  
  102.   (defun collector-loop (ans convgs count)
  103.     (if (= count total-count)
  104.     (progn
  105.       (format t "*** All points converged~%")
  106.       ans)
  107.     (let ((x ()) (y ()) (val ()) (conv ()))
  108.       (linda-in relax-pool 'result (? x) (? y) (? val) (? conv))
  109.       ((setter aref) ans x y val)
  110.       (let ((old (aref convgs x y)))
  111.         (if (eq conv 'conv)
  112.         (progn
  113.           ((setter aref) convgs x y conv)
  114.           (if (null old)    ; new converge
  115.               (progn
  116.             (format t "collector: ~a points converged~%"
  117.                 (+ count 1))
  118.             (collector-loop ans convgs (+ count 1)))
  119.               (collector-loop ans convgs count)))
  120.         (if (null old)
  121.             (collector-loop ans convgs count)
  122.             (progn        ; old unconverged
  123.               ((setter aref) convgs x y ())
  124.               (format t "collector: ~a points converged~%"
  125.                   (- count 1))
  126.               (collector-loop ans convgs (- count 1)))))))))
  127.  
  128.   (defun mutator (n pool)
  129.     (if (linda-read? pool 'stop)
  130.     (format t "relax: finished~%")
  131.     (progn
  132.       (format t "relax: cycle ~a~%" n)
  133.       (relax)
  134.       (thread-reschedule)
  135.       (mutator (+ n 1) pool))))
  136.  
  137.   (deflocal answer ())
  138.  
  139.   (defun doit (initial-mesh eps)
  140.     (setq epsilon eps)
  141.     (setq mesh-size (vector-length initial-mesh))
  142.     (setq mesh-size1 (- mesh-size 1))
  143.     (setq total-count (* mesh-size mesh-size))
  144.     (setq relax-pool (make-linda-pool))
  145.     (setq answer (make-array mesh-size mesh-size))
  146.     (init-mesh initial-mesh)
  147.     (format t "Init done\n")
  148.     (linda-eval mutator 0 relax-pool)
  149.     (collector answer)
  150.     (linda-out relax-pool 'stop)
  151.     answer)
  152.  
  153. )
  154.  
  155. (tril t)
  156.  
  157. (print-linda-pool relax-pool)
  158.